home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / comp / front_end / gen_inter.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  3.5 KB  |  93 lines
  1. (herald (front_end gen_interface)
  2.   (env t (orbit_top defs)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Interface between the front end and the code generator (in addition to the
  28. ;;; node tree).
  29.  
  30. ;;; Is VAR defined in this file.
  31.  
  32. (define (defined-variable? var)
  33.   (and (variable-definition var)
  34.        (local-definition? (variable-definition var))))
  35.  
  36. ;;; Return the node that is the definition of VAR.
  37.  
  38. (define (defined-variable-value var)
  39.   (let ((def (variable-definition var)))
  40.     (if def
  41.         (get-variable-node-value var (definition-variant def))
  42.         nil)))
  43.  
  44. (define (get-variable-node-value var variant)
  45.   (let ((variant (if (eq? variant 'constant) 'define variant)))
  46.     (iterate loop ((refs (variable-refs var)))
  47.       (let ((ref (car refs)))
  48.         (cond ((null? refs)
  49.                nil)
  50.               ((neq? variant (supports-definition ref))
  51.                (loop (cdr refs)))
  52.               (else
  53.                (let ((val ((call-arg 3) (node-parent ref))))
  54.                  (if (lambda-node? val) val nil))))))))
  55.  
  56. ;;; Is VAR not a local variable.
  57.  
  58. (define (defined-variable-exported? var)
  59.   (let ((def (variable-definition var)))
  60.     (not (and def
  61.               (memq? 'local (definition-data def))))))
  62.  
  63. ;;; Get the type of the definition of VAR.
  64.  
  65. (define (defined-variable-variant var)
  66.   (let ((def (variable-definition var)))
  67.     (cond ((not def) 
  68.            nil)
  69.           ((eq? (definition-variant def) 'multiple)
  70.            'define)
  71.           (else
  72.            (definition-variant def)))))
  73.  
  74. ;;; Is VAR definined in this file or in the early binding environment.
  75.  
  76. (define (supported? var)
  77.   (if (variable-definition var) t nil))
  78.  
  79.  
  80. (define (primop-argument-type node)
  81.   (let* ((proc (call-proc (node-parent node)))
  82.          (type (primop.type (primop-value proc) (node-parent node))))
  83.     (if (and type (proc-type? type))
  84.         (vref (proc-type-args type) (relation-index (node-role node)))
  85.         type/top)))
  86.  
  87. (define (primop-result-type var)
  88.   (let ((type (primop-argument-type (variable-binder var))))
  89.     (cond ((and type (proc-type? type))
  90.            (vref (proc-type-args type)
  91.                  (fx- (variable-number var) 1)))
  92.           (else type/top))))
  93.